home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PARAMS / PARAMS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-16  |  11KB  |  379 lines
  1. unit Params;
  2. {
  3.     Handles command-line parameters; can also set default options.
  4.     Copyright 1992 by James M. Clark.
  5.     See also: skel.pas, pardemo.pas, config.exe, config.doc
  6.  
  7. ver. 2, 7-14-92:
  8.     Increased length of OptStr and ParStr to max (255 bytes).
  9. ver. 3, 9-14-92:
  10.     OptStr initially set := version / copyright notice.
  11. }
  12.  
  13. interface
  14.  
  15. uses Dos;
  16.  
  17. {$F+}    {needed to use procedure variables}
  18.  
  19. {
  20.     The application must define procedures ShowUsage, SetOpt,
  21.     DoFile, and AppDone, and set the following procedure variables
  22.     so that the procedures can be used by the Params unit.
  23.     For example:
  24.  
  25.         procedure ShowUsage;
  26.         begin
  27.             - - -
  28.         end;
  29.  
  30.         begin
  31.             PShowUsage:= ShowUsage;
  32.             - - -
  33.         end.
  34. }
  35. var
  36.     {Explain command-line usage:}
  37.     PShowUsage: procedure;
  38.  
  39.     {Set option of OptChr to value of OptStr:}
  40.     PSetOpt: procedure;
  41.  
  42.     {Process the file (or name) FName:}
  43.     PDoFile: procedure(FName: PathStr; Expdd: boolean);
  44.  
  45.     {Prepare to exit application (but don't exit):}
  46.     PAppDone: procedure;
  47.  
  48. {
  49.     The FName parameter of DoFile may or may not be a filename.
  50.     To keep the filename counts correct, DoFile should use as
  51.     appropriate:
  52.  
  53.         procedure IsFile;
  54.         begin
  55.             if not Expdd then begin
  56.                 inc(FileNo);  inc(FPars);
  57.             end;
  58.         end;
  59.  
  60. }
  61.  
  62. {GetDefaults: get default option string:}
  63. {strips any trailing '/' (padding) characters}
  64. function GetDefaults(DefOpts: string): string;
  65.  
  66. {RptError: display error message, and halt/explain/ignore:}
  67. {example message: Can not find file(s): "yourfile.ext".   }
  68. {Dispose is one of these:    }
  69. {    'i': Ignore             }
  70. {    'u': show Usage & halt    }
  71. {    'h': Halt                }
  72. {Dispose mode 'u' calls user-defined ShowUsage procedure; }
  73. {modes 'u' and 'h' call AppDone BEFORE displaying message.}
  74. procedure RptError(Complaint, Name: string; Dispose: char);
  75.  
  76. {GetBool: convert option string OptStr to a boolean value:}
  77. function GetBool: boolean;
  78.  
  79. {GetInt: convert option string OptStr to an integer value:}
  80. function GetInt: integer;
  81.  
  82. {ChkFlg: check if extra characters after a simple flag:}
  83. {for example, /fxy when /f was expected}
  84. procedure ChkFlg;
  85.  
  86. {ParseOpts: scan parameter string ParStr and collect option data:}
  87. {options start with '/' and may run together, e.g.: /b+/c12/d-/eString }
  88. {or may be separated by spaces, e.g.: /b+ /c12     /d- /eString }
  89. {uses PSetOpt to define the options}
  90. procedure ParseOpts(ParStr: string);
  91.  
  92. {ExtendOpt: Extend the option name (OptChr) by taking one}
  93. {character from the option value (OptStr) if available:  }
  94. {If OptStr is '', then append '/' to OptChr instead.     }
  95. function ExtendOpt: ExtStr;
  96.  
  97. {ScanPars: scan the command line, process according to syntax:}
  98. { Parameters starting with '/' are processed by ParseOpts.      }
  99. { Parameters with '*' or '?' are expanded per DOS convention  }
  100. {    (by directory search) to possibly more than one file and  }
  101. {    processed by PDoFile( , true) if MayExpand is true.       }
  102. { Other parameters are processed by PDoFile( , false); these  }
  103. {    may or may not be filenames.                              }
  104. procedure ScanPars;
  105.  
  106. {ExeDir: Get directory of program file if possible, else '':}
  107. function ExeDir: DirStr;
  108.  
  109. {ExeName: Get name of program file if possible, else '':}
  110. function ExeName: NameStr;
  111.  
  112. var
  113.     {The procedure ParseOpts uses these variables to pass current    }
  114.     {option data to procedures PSetOpt and ChkFlg, and to functions }
  115.     {GetBool and GetInt (more efficient than call parameters):        }
  116.  
  117.     Option: ExtStr;     {e.g., the '/c' in '/c12'}
  118.     OptChr: char;        {e.g., the 'c'    in '/c12'}
  119.     OptStr: string;     {e.g., the '12' in '/c12'}
  120.  
  121.     {Alternatively, if PSetOpt uses Optn:= ExtendOpt instead of OptChr,}
  122.     {then:    Option is the '/co' in '/co12'    or '/c' in '/c' }
  123.     {        Optn   is the 'co'    in '/co12'    or 'c'    in '/c' }
  124.     {        OptStr is the '12'    in '/co12'    or ''    in '/c' }
  125.  
  126.     {use these for more info on current file:}
  127.     Dir:  DirStr;        {full pathname of directory}
  128.     SRec: SearchRec;    {full details}
  129.  
  130. const
  131.     {During operation of ScanPars, the user-defined SetOpt and DoFile}
  132.     {procedures may use these to identify parameters and files; each }
  133.     {count starts at 1, but prior to the operation of ScanPars, ParNo}
  134.     { <= 0 may be used to indicate early stage(s) of initialization. }
  135.  
  136.     ParNo:    integer = -1;    {number of current parameter}
  137.     FileNo: word    =  0;    {number of current file}
  138.     FPars:    word    =  0;    {number of expanded parameters}
  139.  
  140.     MayExpand: boolean = true;    {enables filename expansion}
  141.     AttrMask: word = AnyFile-Directory-VolumeID;    {file types to find}
  142.  
  143.     {error messages; used with RptError procedure:}
  144.     sCantFind    = 'Can not find file(s)';
  145.     sBadBool    = 'Option value should be ''+'' or ''-''';
  146.     sBadInt     = 'Option value should be an integer';
  147.     sBadFlag    = 'Extra characters after option';
  148.  
  149.     {corresponding disposal modes; used with RptError procedure:}
  150.     dCantFind:    char = 'i';     {used by ScanPars}
  151.     dBadBool:    char = 'u';     {used by GetBool}
  152.     dBadInt:    char = 'u';     {used by GetInt}
  153.     dBadFlag:    char = 'u';     {used by ChkFlg}
  154.  
  155. {-------------------------------------------------------------}
  156.  
  157. implementation
  158.  
  159. const CopyRight = 'PARAMS.TPU (c) 2-17-92 J. M. Clark';
  160.  
  161. {GetDefaults: get default option string:}
  162. {strips any trailing '/' (padding) characters}
  163.  
  164. function GetDefaults(DefOpts: string): string;
  165. var
  166.     ChrPos: integer;
  167.  
  168. begin
  169.     ChrPos:= Pos('//', DefOpts) - 1;
  170.     if ChrPos < 0 then begin
  171.         ChrPos:= Length(DefOpts);
  172.         if DefOpts[ChrPos] = '/' then dec(ChrPos);
  173.     end;
  174.     GetDefaults:= Copy(DefOpts, 1, ChrPos);
  175. end; {GetDefaults}
  176.  
  177. {RptError: display error message, and halt/explain/ignore:}
  178. {example: Can not find file(s): "yourfile.ext". }
  179. {Dispose is 'i', 'u', or 'h': see below:}
  180.  
  181. procedure RptError(Complaint, Name: string; Dispose: char);
  182. begin
  183.     if (Dispose = 'u') or (Dispose = 'h') then PAppDone;
  184.     write(Complaint, ': "', Name, '".');
  185.     case Dispose of
  186.         'i': {Ignore} begin
  187.             writeln(' (ignored)');
  188.             exit;
  189.         end;
  190.  
  191.         'u': {show Usage & halt} begin
  192.             writeln;
  193.             PShowUsage;
  194.             Halt;
  195.         end;
  196.  
  197.         'h': {Halt} begin
  198.             writeln;
  199.             Halt;
  200.         end;
  201.     end;
  202.     writeln;    {ignore without saying so}
  203. end; {RptError}
  204.  
  205. {GetBool: convert option string OptStr to a boolean value:}
  206.  
  207. function GetBool: boolean;
  208. begin
  209.     if (OptStr = '') or (OptStr = '+') then GetBool:= true
  210.     else if              OptStr = '-'  then GetBool:= false
  211.     else RptError(sBadBool, Option, dBadBool);
  212. end; {GetBool}
  213.  
  214. {GetInt: convert option string OptStr to an integer value:}
  215.  
  216. function GetInt: integer;
  217. var
  218.     int, err: integer;
  219.  
  220. begin
  221.     Val(OptStr, int, err);
  222.     if err = 0 then GetInt:= int
  223.     else RptError(sBadInt, Option, dBadInt);
  224. end; {GetInt}
  225.  
  226. {ChkFlg: check if extra characters after a simple flag:}
  227. {for example, /fxy when /f was expected}
  228.  
  229. procedure ChkFlg;
  230. begin
  231.     if OptStr <> '' then RptError(sBadFlag, Option, dBadFlag);
  232. end; {ChkFlg}
  233.  
  234. {ParseOpts: scan parameter string ParStr and collect option data:}
  235. {options start with '/' and may run together, e.g.: /b+/c12/d-/eString }
  236. {or may be separated by spaces, e.g.: /b+ /c12     /d- /eString }
  237. {uses PSetOpt to define the options}
  238.  
  239. procedure ParseOpts(ParStr: string);
  240. var
  241.     ChrPos: integer; {search position in ParStr}
  242.  
  243. begin
  244.     {we begin with the assumption that ParStr[1] = '/'}
  245.     while Length(ParStr) > 1 do begin        {quit if ParStr end is '/'}
  246.         OptChr:= ParStr[2];
  247.         if OptChr = '/' then exit;            {quit if '//' is found}
  248.         Option:= '/'+OptChr;
  249.  
  250.         {delete the '/' and OptChr from ParStr:}
  251.         Delete(ParStr, 1, 2);
  252.         ChrPos:= Pos(' ', ParStr);            {look for a space, else..}
  253.         if ChrPos = 0
  254.         then ChrPos:= Pos('/', ParStr);     {look for another '/'}
  255.  
  256.         {if no more '/', then OptStr is all remaining of ParStr:}
  257.         if ChrPos = 0 then begin
  258.             OptStr:= ParStr;
  259.             PSetOpt;    {interpret OptChr and OptStr}
  260.             exit;
  261.  
  262.         end else begin
  263.             OptStr:= Copy(ParStr, 1, ChrPos-1);
  264.             PSetOpt;    {interpret OptChr and OptStr}
  265.             Delete(ParStr, 1, ChrPos-1);
  266.             {now the next space or '/' is in ParStr[1]}
  267.             ChrPos:= Pos('/', ParStr);        {look for next '/'}
  268.             while (Length(ParStr) > 2) and (ParStr[1] = ' ')
  269.                 and ((ParStr[2] = '/') or (ParStr[2] = ' '))
  270.             do Delete(ParStr, 1, 1);
  271.         end;
  272.     end; {while}
  273. end; {ParseOpts}
  274.  
  275. {ExtendOpt: Extend the option name (OptChr) by taking one}
  276. {character from the option value (OptStr) if available:  }
  277. {If OptStr is '', then append '/' to OptChr instead.     }
  278.  
  279. function ExtendOpt: ExtStr;
  280. begin
  281.     if Length(OptStr) > 0 then begin
  282.         Option:= Option + OptStr[1];
  283.         ExtendOpt:= OptChr + OptStr[1];
  284.         Delete(OptStr, 1, 1);
  285.     end else begin
  286.         ExtendOpt:= OptChr + '/';    {converts char to string}
  287.     end;
  288. end; {ExtendOpt}
  289.  
  290. {ScanPars: scan the command line, process according to syntax:}
  291. { Parameters starting with '/' are processed by ParseOpts.      }
  292. { Parameters with '*' or '?' are expanded per DOS convention  }
  293. {    (by directory search) to possibly more than one file and  }
  294. {    processed by PDoFile( , true) if MayExpand is true.       }
  295. { Other parameters are processed by PDoFile( , false); these  }
  296. {    may or may not be filenames.                              }
  297.  
  298. procedure ScanPars;
  299. var
  300.     EFiles: word;
  301.     ParStr: string;
  302.     ChrPos: integer;
  303.     Path: PathStr;    {expanded pathname, may have wildcards}
  304.                     {Path = Dir + Name + Ext}
  305.     Name: NameStr;    {may have wildcards}
  306.     Ext:  ExtStr;    {may have wildcards, includes '.'}
  307.  
  308. begin
  309.     FileNo:= 0;
  310.     FPars:= 0;
  311.     for ParNo:= 1 to ParamCount do begin
  312.         ParStr:= ParamStr(ParNo);
  313.         if ParStr[1] = '/' then ParseOpts(ParStr)
  314.         else begin
  315.  
  316.             if MayExpand and
  317.                 ((Pos('*',ParStr) > 0) or (Pos('?',ParStr) > 0))
  318.             then begin
  319.                 EFiles:= 0;
  320.                 inc(FPars);         {count filename parameters}
  321.                 Path:= FExpand(ParStr);
  322.                 FSplit(Path, Dir, Name, Ext);
  323.  
  324.                 {search the directory:}
  325.                 FindFirst(Path, AttrMask, SRec);
  326.                 while DosError = 0 do begin
  327.                     inc(FileNo);    {count all files}
  328.                     inc(EFiles);    {count exanded files for each ParStr}
  329.                     PDoFile(Dir + Srec.Name, true);
  330.                     FindNext(SRec);
  331.                 end;
  332.                 if EFiles = 0 then RptError(sCantFind, Path, dCantFind);
  333.  
  334.             end else begin
  335.                 {ParStr is not necessarily a filename:}
  336.                 {PDoFile may or may not inc FPars and FileNo:}
  337.                 PDoFile(ParStr, false);
  338.             end;
  339.  
  340.         end; {if '/'}
  341.     end; {for}
  342. end; {ScanPars}
  343.  
  344. {ExeDir: Get directory of program file if possible, else '':}
  345.  
  346. function ExeDir: DirStr;
  347. var
  348.     Dir: DirStr;
  349.     Name: NameStr;
  350.     Ext: ExtStr;
  351. begin
  352.     If Lo(DosVersion) >= 3 then begin
  353.         FSplit(ParamStr(0), Dir, Name, Ext);
  354.         ExeDir:= Dir;
  355.     end else ExeDir:= '';
  356. end; {ExeDir}
  357.  
  358. {ExeName: Get name of program file if possible, else '':}
  359.  
  360. function ExeName: NameStr;
  361. var
  362.     Dir: DirStr;
  363.     Name: NameStr;
  364.     Ext: ExtStr;
  365. begin
  366.     If Lo(DosVersion) >= 3 then begin
  367.         FSplit(ParamStr(0), Dir, Name, Ext);
  368.         ExeName:= Name;
  369.     end else ExeName:= '';
  370. end; {ExeName}
  371.  
  372. begin
  373.     FileNo:= 0;
  374.     FPars:= 0;
  375.     MayExpand:= true;
  376.     ParNo:= -1;     {special value for initial ParseOpts}
  377.     OptStr:= 'PARAMS.TPU  9-14-92 (C) James M. Clark';
  378. end.
  379.